home *** CD-ROM | disk | FTP | other *** search
/ BCI NET 2 / BCI NET 2.iso / archives / telecomm / bbs / vb10.lha / VB10.rexx < prev   
Encoding:
OS/2 REXX Batch file  |  1994-04-20  |  4.9 KB  |  222 lines
  1. /*
  2.  * Voting Booth v1.0 for TransAmiga by Roger Clark [December 23, 1991]
  3.  *
  4.  * This version is for TechnoBBS. Nothing major has been changed and the
  5.  * original documentation (VB10.doc) is included. Only the second step of
  6.  * the installation is different for TechnoBBS: Instead of editing cmds
  7.  * files, add following command to one of your menus and compile it.
  8.  * 
  9.  * Command "VOTE"
  10.  * {
  11.  *    dos("rx >NIL: Doors:Poll/VB10.rexx \(node())");
  12.  * }
  13.  *
  14.  * --
  15.  * Janne Siren (jts@krk.fi, BBS: +358-0-505-4201) [April 19, 1994]
  16.  *
  17.  */
  18.  
  19. ln = Arg(1)
  20.  
  21. LineName = Con_LineActive(ln)
  22.  
  23. If LineName = "" Then Exit 10
  24.  
  25. Address Command
  26. Address Value LineName
  27.  
  28. SetStatus "Voting Booth"
  29.  
  30. Name = GetUserName(ln)
  31.  
  32. BBSName        = "Epsilon Indi BBS"
  33.  
  34. VBData        = "Doors:Poll/VBData"
  35. VBResults    = "Doors:Poll/VBResults"
  36. VBUser        = "Doors:Poll/_"||Name
  37.  
  38. ESC    = '1B'X
  39. BRIGHT    = ESC||'[1m'
  40. NOANSI    = ESC||'[0m'
  41.  
  42. f0 = ESC||'[30m' ;b0 = ESC||'[40m'  /* Black  */
  43. f1 = ESC||'[31m' ;b1 = ESC||'[41m'  /* Red    */
  44. f2 = ESC||'[32m' ;b2 = ESC||'[42m'  /* Green  */
  45. f3 = ESC||'[33m' ;b3 = ESC||'[43m'  /* Yellow */
  46. f4 = ESC||'[34m' ;b4 = ESC||'[44m'  /* Blue   */
  47. f5 = ESC||'[35m' ;b5 = ESC||'[45m'  /* Purple */
  48. f6 = ESC||'[36m' ;b6 = ESC||'[46m'  /* Cyan   */
  49. f7 = ESC||'[37m' ;b7 = ESC||'[47m'  /* White  */
  50.  
  51. CR    = D2C(13)
  52. LF    = D2C(10)
  53. CLS    = D2C(12)
  54. CRLF    = CR||LF
  55. CLS    = "H"
  56.  
  57. LockCarrier
  58.  
  59. If ~exists(VBData) then call NoVote
  60. Call Open('Data',VBData,'R')
  61.   QNum = Readln('Data')
  62.   Do A = 1 to QNum
  63.     QText.A.0 = Readln('Data')
  64.     QAnsNum.A = Readln('Data')
  65.     Do B = 1 to QAnsNum.A
  66.       QText.A.B = Readln('Data')
  67.     End
  68.   End
  69. Call Close('Data')
  70.  
  71. /* If the Result file doesn't exist, make a blank one */
  72.  
  73. If ~Exists(VBResults) then do
  74.   Call Open('Res',VBResults,'W')
  75.     Call Writeln('Res',0)
  76.   Call Close('Res')
  77.   ResNum = 0
  78.   Call PadRes
  79. End
  80.  
  81. /* Open and read in past voting results */
  82.  
  83. Call Open('Res',VBResults,'R')
  84.   ResNum = Readln('Res')
  85.   If Resnum > 0 then do
  86.     Do A = 1 to ResNum
  87.       Pick.A.0 = Readln('Res')
  88.       Do B = 1 to Pick.A.0
  89.         Pick.A.B = Readln('Res')
  90.       End
  91.     End
  92.   End
  93. Call Close('Res')
  94.  
  95. PadRes:
  96. If ResNum < QNum Then do      /* More questions than results */
  97.   ResNum = ResNum + 1         /* So we pad the result file.  */
  98.   Do A = ResNum  to QNum
  99.     Pick.A.0 = QAnsNum.A
  100.     Do B = 1 to QAnsNum.A
  101.       Pick.A.B = 0
  102.     End
  103.   End
  104. End
  105.  
  106. /* Check for userfile and read in the data, or create one if needed */
  107.  
  108. UNum = 0
  109. If exists(VBUser) then do
  110.   Call Open('User',VBUser,'R')
  111.   UNum = Readln('User')
  112.   Do A = 1 to UNum
  113.     UPick.A = Readln('User')
  114.   End
  115.   Call Close('User')
  116. End
  117.  
  118. If Unum < QNum then do
  119.   UNum = UNum + 1
  120.   Do A = Unum to QNum
  121.     UPick.A = 0
  122.   End
  123. End
  124.  
  125. /* Present a choice of questions to vote on */
  126.  
  127. Main:
  128. SendModem CLS||F7||'-----=( '||F2||BBSName||F3||' Voting Booth v1.0'||F7||' )=-----'||CRLF||CRLF
  129.  
  130. Do A = 1 to QNum
  131.   If UPick.A = 0 then VF = "* "
  132.   If UPick.A > 0 then VF = "  "
  133.   SendModem F1||VF||F3||A||F6||") "||F3||QText.A.0||CRLF
  134. End
  135.  
  136. Opt = AskInput(ln, CRLF||F7||'Question '||F6||'('||F7||' 1'||F6||'-'||F7||Qnum||F6||','||F7||' Q'||F6||'='||F7||'Quit '||F6||')'||F3||': '||F7, "", 10, "CAPITAL")
  137.  
  138. If ~CheckCarrier(ln) then call DropCarrier
  139.  
  140. If Upper(Opt) = 'Q' then Call Done
  141. If Opt < 1 | Opt > QNum then call Main
  142.  
  143. /* Vote on a particular question */
  144.  
  145. VoteLoop:
  146. SendModem CLS||F2||QText.Opt.0||CRLF||CRLF
  147.  
  148. TV = 0
  149. Do D = 1 to QAnsNum.Opt
  150.   TV = TV + Pick.Opt.D
  151. End
  152. Do C = 1 to QAnsNum.Opt
  153.   VF = "  "
  154.   If UPick.Opt = C Then VF = "* "
  155.   X = Length(QText.Opt.C) ; S = 45 - X ;
  156.   SPC = " "
  157.   Do T = 1 to S
  158.     SPC = SPC||"."
  159.   End
  160.   If TV = 0 then PCNT = 0
  161.   If TV > 0 Then PCNT = (100 * (Pick.Opt.C / TV)) % 1
  162.   SendModem F1||VF||F3||C||F6||") "||F3||QText.Opt.C||F2||SPC||F3||PCNT||"% "||F1||"["||F3||Pick.Opt.C||F1||"]"||CRLF
  163. End
  164. SendModem CRLF
  165. If UPick.Opt > 0 then do
  166.   CV = GetYesNo(ln, 'Would you like to change your vote?'||F7, 0, 1)
  167.  
  168.   If ~CheckCarrier(ln) then call DropCarrier
  169.  
  170.   If CV = 1 then do
  171.     X = UPick.Opt
  172.     UPick.Opt = 0
  173.     Pick.Opt.X = Pick.Opt.X - 1
  174.     Call VoteLoop
  175.   End
  176.  
  177.   Call Main
  178. End
  179. Ans = AskInput(ln, F7||'Answer '||F6||'('||F7||' 1'||F6||'-'||F7||QAnsNum.Opt||F6||','||F7||' Q'||F6||'='||F7||'Quit '||F6||')'||F3||': '||F7, "", 10, "CAPITAL")
  180.  
  181. If ~CheckCarrier(ln) then call DropCarrier
  182.  
  183. If Upper(Ans) = 'Q' then Call Main
  184. If Ans <1 | Ans > QAnsNum.Opt then call VoteLoop
  185. UPick.Opt = Ans
  186. Pick.Opt.Ans = Pick.Opt.Ans + 1
  187. Call Main
  188.  
  189. NoVote:
  190. SendModem CLS||'-----=( No Voting Topics )=-----'||CRLF||CRLF
  191. UnLockCarrier
  192. Exit 0
  193.  
  194. DropCarrier:
  195. UnLockCarrier
  196. Exit 0
  197.  
  198. Done:
  199. SendModem CRLF
  200. Address Command 'Delete '||VBResults
  201. Call Open('Res',VBResults,'W')
  202.   Call Writeln('Res',QNum)
  203.   Do A = 1 to QNum
  204.     Call Writeln('Res',Pick.A.0)
  205.     Do B = 1 to Pick.A.0
  206.       Call Writeln('Res',Pick.A.B)
  207.     End
  208.   End
  209. Call Close('Res')
  210. If Exists(VBUser) then do
  211.   Address Command 'Delete "'||VBUser||'"'
  212. End
  213. Call Open('User',VBUser,'W')
  214.   Call Writeln('User',QNum)
  215.   Do A = 1 to QNum
  216.     Call Writeln('User',UPick.A)
  217.   End
  218. Call Close('User')
  219.  
  220. UnLockCarrier
  221. Exit 0
  222.